PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/dgsay.exe/DGSAY.PAS

Pascal/Delphi Source File | 1989-06-30 | 38.2 KB | 1,072 lines

{
 ╔═════════════════════════════════════════════════════════════════════════╗
 ║                                                                         ║
 ║        TITLE :      DGSAY.TPU,  Version 8907.01                         ║
 ║      PURPOSE :      Write formatted text to screen.                     ║
 ║       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            ║
 ║  _____________________________________________________________________  ║
 ║                                                                         ║
 ║   Written in Turbo Pascal, Version 5.5,                                 ║
 ║   with routines from Turbo Professional, Version 5.0.                   ║
 ║                                                                         ║
 ║   Turbo Pascal is a product of Borland International.                   ║
 ║   Turbo Professional is a product of TurboPower Software                ║
 ║  _____________________________________________________________________  ║
 ║                                                                         ║
 ║  This is not public domain software.  This is shareware.                ║
 ║  This software is copyright 1989, by David Gerrold.                     ║
 ║                                                                         ║
 ║        The Brass Cannon Corporation                                     ║
 ║        9420 Reseda Blvd., #804                                          ║
 ║        Northridge, CA 91324-2932.                                       ║
 ║                                                                         ║
 ║  If you find this code useful, a donation of $25 is requested --        ║
 ║  not to me, but to the AIDS Project Los Angeles.  Donations may         ║
 ║  be forwarded via the Brass Cannon address.  Thank you.                 ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝
                                                                            }
{ ========================================================================= }
{  Compiler Directives :                                                    }
{ ========================================================================= }

{$R-}    {Range checking off}
{$B+}    {Boolean complete evaluation on}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$N+,E+} {Simulate numeric coprocessor}
{$M 65520,16384,655360} {Turbo 3 default stack and heap}
{$V-}    {Variable range checking off}

{ ========================================================================= }
{ ========================================================================= }

UNIT DGsay;

{ ========================================================================= }
INTERFACE
{ ========================================================================= }

USES
  Dos,                                           { TP5.5 unit }
  TpDos,                                         { Turbo Professional unit }
  TpCrt,                                         { Turbo Professional unit }
  TpString,                                      { Turbo Professional unit }
  DgInit,                                        { Dg initialization }
  DgStr;                                         { Dg string object }

{ ========================================================================= }

TYPE
{
  The SayKrnl-Object is the kernel ancestor for Say-Ob (see below);
  None of the methods in SayKrnlOb are intended to be directly called
  by the user;  they are for the internal workings of Say-Ob and its
  descendants.

  The variables Indent, Width, JustifyFlag, and NormalAttr,
  should be accessed only by the methods in SayOb.  The variable
  CurrentAttr is for the object's internal bookkeeping and should
  not be tampered with at all.

  The Send and SendKrnl methods are virtual, so that a child object can
  be spawned for writing directly to the printer or to a disk file.  The
  next version of this unit will contain such descendant objects.
}

  SayKrnlOb = Object (StrOb)
    Indent       : byte;                         { left indent }
    Width        : byte;                         { paragraph width }
    JustifyFlag  : boolean;                      { right justify or not? }

    NormalAttr   : byte;                         { normal attribute }
    CurrentAttr  : byte;                         { current attribute }

    Constructor Init;
    Function    GetLineBreak  (CheckStr : string) : byte;
    Function    Justify (Jstr : string) : string;
    Function    WordWrap (Limit : byte) : string;
    Procedure   SendKrnl (SendStr : string);  virtual;
    Procedure   Send     (SendStr : string);  virtual;
    Procedure   SayKrnl  (AddStr  : string);
    end;

{
  The Say-Object is a replacement for the WriteLn procedure.  Use Say
  and SayLn instead of Write and WriteLn.  The difference is that Say
  will automatically reformat consecutive lines of text.  You can set
  a defined screen width and SayOb will format the text to that width.
  You may also specify a left-indent).

  Use consecutive Say ('<text>') commands to output formatted text
  to the screen.  Use a SayLn ('<text>') command to end the paragraph
  and empty the SayOb buffer.  Two consecutive SayLn ('') commands will
  end the paragraph and output a blank line to the screen;

  If there is no text in the SayOb buffer, you may use SayLn ('') to
  produce a blank line on screen.
}
  SayOb = Object (SayKrnlOb)
    Constructor Init;
    Procedure   SetIndent (I : byte);
    Procedure   SetWidth (W : byte);
    Procedure   SetAttr (A : byte);              { set NormalAttr }
    Procedure   SetParams (I, W, A : byte;
                           Jflag : boolean);
    Procedure   JustOn;
    Procedure   JustOff;

    Function    AttrStr (SetStr : string;
                         A : byte) : string;

    Procedure   SayLn   (AddStr  : string);
    Procedure   Say     (AddStr  : string);
    Procedure   SayPara (AddStr  : string);
    Procedure   SayAttr (AddStr  : string;
                            Attr : byte);
  end;

VAR
  Simon : SayOb;

CONST
  TabStr = '     ';                              { standard para indent }

{ ========================================================================= }

PROCEDURE SayDoc;                                { simultaneous doc/demo }

{ ========================================================================= }
IMPLEMENTATION
{ ========================================================================= }

CONSTRUCTOR SayKrnlOb.Init;

BEGIN
  S      := '';
  Indent := 5;
  Width  := 70;
  JustifyFlag := true;

  NormalAttr  := TextAttr;
  CurrentAttr := TextAttr;
END;

{ ========================================================================= }

FUNCTION SayKrnlOb.GetLineBreak (CheckStr : string) : byte;
{
  Locates the place to break the string for Wordwrap, allowing for
  imbedded control characters.  Also used by the Justify function to
  check the length of the string to be justified.
}
VAR
  Len  : byte absolute CheckStr;
  Loop : byte;
  Ctr  : byte;

BEGIN
  Ctr := Width;                                  { break here }
  Loop := 0;
  Repeat
    inc (Loop);                                  { count through str }
    if CheckStr [Loop] = #0 then begin           { if attribute change }
      inc (Ctr, 2);                              { count it }
      inc (Loop);                                { step past it }
      end;
  Until
    (Loop >= Ctr)
      or
    (Loop >= Len);                                { until end of str }

  GetLineBreak := Ctr;                            { return count }
END;

{ ========================================================================= }

FUNCTION SayKrnlOb.Justify (Jstr : string) : string;
{
  Returns a string internally padded with spaces so that length = limit.
}
VAR
  Jlen      : byte absolute Jstr;

  Loop      : byte;
  LineBreak : byte;

  SpaceCtr,
  SpaceCtr2 : byte;
  InsertCtr : byte;
  AddNum    : byte;
  StartPos  : byte;

CONST
  FlipFlag : boolean = false;

BEGIN
  LineBreak := GetLineBreak (Jstr);              { allow for ctrl-chars }
  If Jlen < LineBreak then                       { if padding needed }
    If JustifyFlag then begin                    { if justify flat is on }
      StartPos := 5 *                            { start count at what pos }
        ord ((Pos (TabStr, Jstr) > 0)            { does Jstr start with }
        and (Pos (TabStr, Jstr) < 4));           { a new paragraph? }
      SpaceCtr := 0;                             { zero out counter }
      For Loop := StartPos to Jlen do            { loop through Jstr }
        If Jstr [Loop] = ' ' then
          inc (SpaceCtr);                        { count spaces }

      InsertCtr := 0;                            { how many to insert }
      AddNum := LineBreak - Jlen;                { how many spaces to add }
      SpaceCtr2 := 0;                            { count spaces again }
      If FlipFlag then
        begin
        Loop := StartPos;
        Repeat
          inc (Loop);
          If Jstr [Loop] = ' ' then begin
            If (InsertCtr/AddNum < SpaceCtr2/SpaceCtr) then begin
              Insert (' ', Jstr, Loop);
              inc (InsertCtr);
              inc (Loop);
              end;
            Inc (SpaceCtr2);                     { count spaces }
            end;
        Until
          Loop >= Jlen;
        end
      else
        begin
        Loop := Jlen;
        Repeat
          dec (Loop);
          If Jstr [Loop] = ' ' then begin
            If (InsertCtr/AddNum < SpaceCtr2/SpaceCtr) then begin
              Insert (' ', Jstr, Loop);
              inc (InsertCtr);
              end;
            Inc (SpaceCtr2);                     { count spaces }
            end;
        Until
          Loop <= StartPos;
        end;

      FlipFlag := not FlipFlag;                  { next time, go other way }
      If Jlen < LineBreak then Jstr := Justify (Jstr);
      end;
  Justify := Jstr;
END;

{ ========================================================================= }

FUNCTION SayKrnlOb.WordWrap (Limit : byte) : string;
{
  If S is greater than width, WordWrap will break S in two at the last
  space possible, returning the first part of the string as the result
  of the function and deleting it from S, which will contain only the
  remainder.  Additional text can then be appended to S for another
  go-round.
}
VAR
  Loop : byte;
  Len  : byte absolute S;

BEGIN
  Loop := Limit;                                 { start at screen width }
  While
    (Loop > 0)                                   { while str > '' }
      and                                        { and }
    (
    (S [Loop] <> ' ')                            { char not space }
      or                                         { or }
    (S [pred (Loop)] = #0)                       { pred char is attr flag }
    )
  do
    dec (Loop);                                  { count backward }
  If Loop = 0 then                               { if no space }
    Loop := Limit                                { break at limit }
  else
    While
      (S [Loop] = ' ')                           { if loop at space }
        and
      (S [pred (Loop)] <> #0)
    do
      dec (Loop);                                { decrement }
  WordWrap := Justify (SubStr (1, Loop));        { return justified str }
  S := SubStr (succ (Loop), Len);                { delete it from S }
  TrimCh (' ');                                  { delete spaces }
END;

{ ========================================================================= }

PROCEDURE SayKrnlOb.SendKrnl (SendStr : string);
{
  The thingamabob that does the job for the thingamabob that does the job
  for the thingamabob that does the job....
}
VAR
  AttrPos : byte;
  Slen    : byte absolute SendStr;

BEGIN
  AttrPos := Pos (#0, SendStr);                  { are there attr changes? }

  If AttrPos = 0 then begin                      { if no attr changes }
    FastWrite (SendStr,
      WhereY, WhereX, CurrentAttr);              { fastwrite text }
    WriteLn;                                     { go to next line }
    end
  else begin                                     { else: }
    FastWrite (GetSubStr (SendStr, 1, pred (AttrPos)),
               WhereY, WhereX, CurrentAttr);     { write the first text }
    Gotoxy (WhereX + pred (AttrPos), WhereY);    { advance cursor }
    CurrentAttr :=
      ord (SendStr [succ (AttrPos)]);            { get new attr }
    Delete (SendStr, 1, succ (AttrPos));         { discard first text }
    SendKrnl (SendStr);                          { recursive part of send }
    end;
END;

{ ========================================================================= }

PROCEDURE SayKrnlOb.Send (SendStr : string);
{
  The thingamabob that does the job for the thingamabob that does the job.

  Send puts the cursor at the indent, then calls SendKrnl, which is a
  recursive procedure, to finish writing the text to the screen.
}
BEGIN
  Gotoxy (Indent, WhereY);                     { left indent }
  SendKrnl (SendStr);
END;

{ ========================================================================= }

PROCEDURE SayKrnlOb.SayKrnl (AddStr : string);
{
  The thingamabob that does the job.
}

VAR
  Len       : byte absolute S;
  LineBreak : byte;
  Loop      : byte;                              { trash variable }

BEGIN
  AddStr := #0 + chr (NormalAttr) + AddStr;      { reset normal attr }
  If Len = 0 then                                { if no S then }
    S := AddStr                                  { start with AddStr }
  else begin
    Loop := Len;
    If S [pred (loop)] = #0 then                 { if len = attr char }
      dec (Loop, 2);                             { look back 2 }
    if InTwoSpacePunctuation (S [Loop]) then     { last char ends sentence? }
      Append ('  ' + AddStr)                     { add two spaces }
    else
      Append (' ' + AddStr);                     { else add only one space }
    end;
  TrimTrailCh (' ');                             { delete extra spaces }

  Repeat                                         { repeat }
    LineBreak := GetLineBreak (S);               { find place to break }
    If Len > LineBreak then                      { if S > width }
      Send (WordWrap (LineBreak));               { send wordwrapped text }
  Until
    Len <= LineBreak;                            { until S too short }
END;

{ ========================================================================= }

CONSTRUCTOR SayOb.Init;

BEGIN
  SayKrnlOb.Init;
END;

{ ========================================================================= }

PROCEDURE SayOb.SetIndent (I : byte);

BEGIN
  Indent := I;
END;

{ ========================================================================= }

PROCEDURE SayOb.SetWidth (W : byte);

BEGIN
  Width := W;
END;

{ ========================================================================= }

PROCEDURE SayOb.SetAttr (A : byte);

BEGIN
  NormalAttr  := A;
END;

{ ========================================================================= }

PROCEDURE SayOb.SetParams (I, W, A : byte;  Jflag : boolean);

BEGIN
  SetIndent (I);
  SetWidth (W);
  SetAttr (A);
  JustifyFlag := JFlag;
END;

{ ========================================================================= }

PROCEDURE SayOb.JustOn;
BEGIN
  JustifyFlag := true;
END;

{ ========================================================================= }

PROCEDURE SayOb.JustOff;
BEGIN
  JustifyFlag := false;
END;

{ ========================================================================= }

FUNCTION SayOb.AttrStr (SetStr : string;  A : byte) : string;
{
  Surrounds a string with two codes, the first to change it to a new attr,
  the second to return it to the NormalAttr (normal attr for object).
}
BEGIN
  AttrStr :=  #0 + chr (A) + SetStr + #0 + chr (NormalAttr);
END;

{ ========================================================================= }

PROCEDURE SayOb.SayLn (AddStr : string);
{
  Forces an end to a displayed paragraph of text.
  Calls SayKrnl ('<text>'), then writes last line of text
  to screen and flushes S.
}

VAR
  SaveJustifyFlag : boolean;

BEGIN
  SayKrnl (AddStr);                              { send formatted text }
  SaveJustifyFlag := JustifyFlag;                { save justification }
  JustifyFlag := false;                          { turn justification off }
  Send (S);                                      { send last text }
  S := '';                                       { empty buffer }
  JustifyFlag := SaveJustifyFlag;                { restore justification }
END;

{ ========================================================================= }

PROCEDURE SayOb.Say (AddStr : string);
{
  Replaces the Write procedure.  Consecutive calls to Say will
  display formatted text on screen.
}
BEGIN
  If Pos ('@NEW', AddStr) > 0 then               { filter paragraph command }
    Replace ('@NEW', TabStr);
  If (Pos (TabStr, AddStr) > 0)                  { new paragraph? }
       and
     (Pos (TabStr, AddStr) < 4)
  then
    SayLn ('');                                  { finish old paragraph }

  SayKrnl (AddStr);                              { write it }
END;

{ ========================================================================= }

PROCEDURE SayOb.SayPara (AddStr : string);
{
  Starts a new paragraph.  If the user has inserted leading spaces in the
  line, these are deleted and replaced with a standardized tab indent.
}
BEGIN
  AddStr := TrimLeadChars (AddStr, ' ');         { remove extra spaces }
  Say (TabStr + AddStr);                         { write it }
END;

{ ========================================================================= }

PROCEDURE SayOb.SayAttr (AddStr : string;  Attr : byte);
{
  Encodes text with new attribute, then sends it to be said.
}
BEGIN
  Say (AttrStr (AddStr, Attr));
END;

{ ========================================================================= }

PROCEDURE SayDoc;
{
  Test routine for demonstrating Say-Ob.  Run the test program appended
  to this unit.  It will call this procedure and demonstrate the Say
  and SayLn methods.
}
CONST
  HeadLine  : SayOb =
    (Row    : 1;                                 { irrelevant to this ob }
     Col    : 1;                                 { the compiler demands it }
     S      : '';                                { the string }
     Indent : 0;
     Width  : 79;
     JustifyFlag : true;
     NormalAttr  : LightGreen;
     CurrentAttr : LightGreen);

  NormText  : SayOb =
    (Row    : 1;
     Col    : 1;
     S      : '';
     Indent : 5;
     Width  : 70;
     JustifyFlag : true;
     NormalAttr  : LightBlue;
     CurrentAttr : LightBlue);

  IndentedText : SayOb =
    (Row    : 1;
     Col    : 1;
     S      : '';
     Indent : 10;
     Width  : 60;
     JustifyFlag : true;
     NormalAttr  : LightGray;
     CurrentAttr : LightGray);

   NameAttr    : byte = White;
   CommandAttr : byte = Yellow;
   VarAttr     : byte = LightCyan;
   ItalicAttr  : byte = LightMagenta;

BEGIN
  ClrScr;
  HiddenCursor;
  TextAttr := Yellow;
  WriteLn ('DgSay demonstration begins here:');
  WriteLn;

  With HeadLine do begin
    Say ('This is the documentation for');
    Say (AttrStr ('DgSay', NameAttr) + '.');
    Say ('This is also a simultaneous demonstration of how');
    SayAttr ('DgSay', NameAttr);
    SayLn ('can be used to enhance the outputted text of a program.');
    end;

  With NormText do begin
    SayPara (AttrStr ('DgSay', NameAttr));
    Say ('is a Turbo Pascal unit designed');
    Say ('to simplify the task of outputting formatted text to the');
    Say ('screen.');
    Say ('The');
    SayAttr ('DgSay', NameAttr);
    Say ('unit contains an object called');
    Say (AttrStr ('SayOb', NameAttr) + ', plus a declared instance');
    Say ('of the object called ' + AttrStr ('Simon', VarAttr) + '.');
    SayAttr ('Simon', VarAttr);
    Say ('is automatically initialized within the unit and');
    Say ('is ready to use in your own programs.');
    Say ('Simply add');
    SayAttr ('USES DgSay', CommandAttr);
    SayLn ('to the beginning of your code.');

    SayPara ('You can use');
    Say (AttrStr ('Simon', VarAttr) + ',');
    Say ('or you can declare instances of your own, each with');
    Say ('its own margins and attributes.');
    Say ('Using the methods in the');
    SayAttr ('SayOb', NameAttr);
    Say ('object you can display formatted');
    SayAttr ('(and optionally justified)', ItalicAttr);
    Say ('blocks of text as easily as if you were writing a series of');
    Say (AttrStr ('WriteLn (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('commands.  You can also use different');
    Say (AttrStr ('C', LightRed) +
         AttrStr ('O', Yellow) +
         AttrStr ('L', LightGreen) +
         AttrStr ('O', LightCyan) +
         AttrStr ('R', LightBlue) +
         AttrStr ('S', LightMagenta));
    SayLn ('to highlight individual words or whole blocks of text.');
    SayLn ('');
    end;
    Pause;
    ClrScr;

  With HeadLine do
    SayLn ('How it works:');

  With NormText do begin
    SayPara ('The');
    SayAttr ('SayOb', NameAttr);
    Say ('works with a simple one-string buffer.');
    Say ('To send formatted text to the screen,');
    Say ('you use consecutive calls of');
    Say (AttrStr ('Simon.Say (', CommandAttr) +
         AttrStr ('<text to output>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('to fill the buffer.');
    Say ('Each call to');
    Say (AttrStr ('Say (', CommandAttr) +
         AttrStr ('<text to output>', VarAttr) +
         AttrStr (')', CommandAttr));
    SayLn ('adds its text to the end of the buffer.');


    SayPara ('Every time the buffer grows');
    Say ('beyond the declared width of the text, a routine within the');
    SayAttr ('SayOb', NameAttr);
    Say ('object sends formatted lines of');
    Say ('text to the screen, until the buffer');
    Say ('size is once again less than the declared width.');
    Say ('This usually leaves a small amount of text in the buffer.');
    Say ('At the end of a block of text, you flush the buffer with a');
    Say ('call to the');
    Say (AttrStr ('SayLn (', CommandAttr) +
         AttrStr ('<text to output>', VarAttr) +
         AttrStr (')', CommandAttr));
    SayLn ('method.');
    SayLn ('');
    end;

  With HeadLine do begin
    Say ('You are invited to examine the source code');
    SayLn ('of this demonstration to see how it''s done.');
    SayLn ('');
    end;

    Pause;
    ClrScr;

  With HeadLine do
    SayLn ('How to send formatted text to the screen:');

  With NormText do begin
    SayPara ('The simplest way to send formatted text is with the');
    Say (AttrStr ('Say (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method, where');
    SayAttr ('<text>', VarAttr);
    SayLn ('represents a string of text to be written.');

    SayPara ('Consecutive calls to the');
    Say (AttrStr ('Say (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method will append');
    Say ('each new piece of text to the end of the line buffer.');
    Say ('Appropriate spacing is always maintained.  External');
    Say ('spaces are trimmed from the text to be appended, then');
    Say ('one space is inserted between the preceding text and');
    Say ('the text to be appended;');
    Say ('two spaces are inserted if the preceding text ends with a');
    Say ('colon, period, exclamation point,');
    SayLn ('semi-colon, or question mark.');

    SayPara ('Each time the line buffer grows beyond');
    Say ('the declared width of the format,');
    SayAttr ('Simon', VarAttr);
    Say ('will output formatted lines of text until the buffer size');
    SayLn ('is again below the declared width.');

    SayPara ('To end a paragraph, use the');
    Say (AttrStr ('SayLn (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method.');
    Say (AttrStr ('SayLn (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('first calls the');
    Say (AttrStr ('Say (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method to finish writing any formattable text');
    Say ('to the screen, then it');
    Say ('writes all the remaining text to the screen and empties');
    Say ('the buffer.');
    Say ('A call to');
    Say (AttrStr ('SayLn (', Yellow) +
         AttrStr ('<text>', LightCyan) +
         AttrStr (')', Yellow));
    SayLn ('always flushes the line buffer.');
    SayLn ('');
    end;

    Pause;
    ClrScr;

  With HeadLine do
    SayLn ('How to start a new paragraph:');

  With NormText do begin
    SayPara ('The simplest way to start a new paragraph is with the');
    Say (AttrStr ('SayPara (', Yellow) +
         AttrStr ('<text>', LightCyan) +
         AttrStr (')', Yellow));
    Say ('method, where');
    SayAttr ('<text>', LightCyan);
    Say ('represents the first string of text in the paragraph.');
    Say ('Follow this with as many calls to the');
    Say (AttrStr ('Say (', Yellow) +
         AttrStr ('<text>', LightCyan) +
         AttrStr (')', Yellow));
    SayLn ('method as are necessary to complete the paragraph.');
    end;

  With IndentedText do begin
    SayPara ('If you are writing consecutive paragraphs');
    Say ('you do not need to call the');
    Say (AttrStr ('SayLn (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method to end the paragraph.  Every time you call');
    Say (AttrStr ('SayPara (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('it first calls');
    Say (AttrStr ('SayLn (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('to flush all text still in the line buffer.');
    Say ('If you do call the');
    Say (AttrStr ('SayLn (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method, followed by a call to');
    Say (AttrStr ('SayPara (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('you will get a blank line between the two');
    SayLn ('paragraphs.');
    end;

  With NormText do begin
    SayPara ('The');
    SayAttr ('other', ItalicAttr);
    Say ('way to start a paragraph is to put');
    SayAttr ('five blank spaces', ItalicAttr);
    Say ('at the beginning of a text string.  This will produce');
    Say ('the exact same result as a call to the');
    Say (AttrStr ('SayPara (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method.');
    SayLn ('Do not use ' +
         AttrStr ('^I', VarAttr) +
         ', it will not be recognized as a paragraph indent.');
    SayLn ('');
    end;

    Pause;
    ClrScr;

  With HeadLine do
    SayLn ('How to set the margins and attributes:');

  With NormText do begin
    SayPara ('The left indent on this paragraph');
    Say ('has been set to 5, the format width');
    Say ('has been set to 70.  This will produce a margin of 5');
    SayLn ('on both the right and the left sides of the screen.');

    SayPara ('The best way to set margins and attributes is to');
    Say ('declare an instance of');
    SayAttr ('SayOb', NameAttr);
    Say ('as a typed constant.');
    SayLn ('(See the source code for examples.)');
    SayPara ('If you wish to change the margins of an object after');
    Say ('it has been initialized, you may use the');
    Say (AttrStr ('SetIndent (', CommandAttr) +
         AttrStr ('<Indent>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method, where');
    SayAttr ('<Indent>', VarAttr);
    Say ('represents the number of columns to indent, and the');
    Say (AttrStr ('SetWidth (', CommandAttr) +
         AttrStr ('<Width>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method, where');
    SayAttr ('<Width>', LightCyan);
    Say ('represents the formatted length of the text line.');
    Say ('You can reset margins in the middle of a block of text;');
    SayLn ('but the results may not always be predictable.');

    SayPara ('The attribute for text may be set with the');
    Say (AttrStr ('SetAttr (', CommandAttr) +
         AttrStr ('<Attr>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method, where');
    SayAttr ('<Attr>', VarAttr);
    Say ('represents the desired attribute.');
    Say ('You may reset the attribute at any time within a block');
    SayLn ('of text.');
    SayLn ('');
    end;

    Pause;
    ClrScr;

  With HeadLine do
    SayLn ('How to turn justification on and off:');

  With IndentedText do begin
    JustOff;
    SayPara ('Not everybody wants justified text.  Some people');
    Say ('find it annoying.  You can switch text justification');
    SayAttr ('on', ItalicAttr);
    Say ('and');
    SayAttr ('off', ItalicAttr);
    Say ('with the');
    SayAttr ('JustOn', CommandAttr);
    Say ('and');
    SayAttr ('JustOff', CommandAttr);
    Say ('methods.');
    Say ('With justification set to');
    Say (AttrStr ('off', ItalicAttr) + ',');
    Say ('the formatting routines will continue to format text from');
    Say ('the line buffer;  but the lines will not be padded to meet');
    Say ('the right margin precisely.  This paragraph is');
    SayAttr ('not', ItalicAttr);
    SayLn ('justified.');
    JustOn;
    end;

  With NormText do begin
    SayPara ('You can also set all of the margin and attribute parameters');
    Say ('at the same time with a call to the');
    Say (AttrStr ('SetParams (', CommandAttr) +
         AttrStr ('<Indent, Width, Attr, JustifyFlag>', LightCyan) +
         AttrStr (')', CommandAttr));
    Say ('method.');
    Say ('Generally, you should only reset the margin parameters');
    Say ('and the Justify flag between paragraphs, or');
    Say ('when the text buffer is empty;  otherwise, the results could');
    Say ('be unpredictable.  You may safely reset the text attribute');
    SayLn ('at any time.');
    SayLn ('');
    end;

    Pause;
    ClrScr;

  With HeadLine do
    SayLn ('More about Attributes:');

  With NormText do begin
    SayPara ('As you can see,');
    SayAttr ('SayOb', NameAttr);
    Say ('is also capable of formatting text in color.');
    Say ('You can write text to the screen in any attribute');
    SayLn ('you choose.');

    SayPara ('Examples:');
    SayAttr ('Black on LightGray.', BlackLightGray);
    Say (AttrStr ('White on Red', WhiteRed) +
         AttrStr (' Yellow on Red.', YellowRed));
    SayAttr ('LightCyan + blinking.', LightCyan + blinking);
    SayAttr ('Light Green on Green.', LightGreenGreen);
    Say (AttrStr ('Light Magenta.', LightMagenta));
    Say (AttrStr (' White on Brow', WhiteBrown) +
         AttrStr ('n and Green', WhiteGreen));
    SayAttr ('Light Red + blinking on Magenta.', LightRedMagenta + blinking);
    SayLn (AttrStr ('Or even a nice restful dark gray.', DarkGray));

    SayPara ('Attributes can be set in two ways.');
    Say ('The easiest way is with a call to the');
    Say (AttrStr ('SayAttr (', CommandAttr) +
         AttrStr ('<Text, Attr>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method, where');
    SayAttr ('Text', VarAttr);
    Say ('is the string to be written, and');
    SayAttr ('Attr', VarAttr);
    SayLn ('is the attribute.');
    SayPara ('In all other respects,');
    Say (AttrStr ('SayAttr (', CommandAttr) +
         AttrStr ('<Text, Attr>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('works exactly like the');
    Say (AttrStr ('Say (', CommandAttr) +
         AttrStr ('<Text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method.');
    Say (AttrStr ('SayAttr (', CommandAttr) +
         AttrStr ('<Text, Attr>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('only writes its own text in the new attribute.  The normal');
    Say ('attribute for the rest of the paragraph is not affected.');
    Say ('The only disadvantage of using the');
    Say (AttrStr ('SayAttr (', CommandAttr) +
         AttrStr ('<Text, Attr>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('method is that, like');
    Say (AttrStr ('Say (', CommandAttr) +
         AttrStr ('<Text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('it will add spaces around the text as it appends it to the');
    SayLn ('line buffer.  There are times when you may not want to do this.');
    SayLn ('');
    end;

    Pause;
    ClrScr;

  With HeadLine do begin
    Say ('The');
    SayAttr ('other', ItalicAttr);
    SayLn ('way to set the attribute (cont''d):');
    end;

  With NormText do begin
    SayPara ('The');
    Say ('other way to set an attribute is to call the');
    Say (AttrStr ('AttrStr (', CommandAttr) +
         AttrStr ('<Text, Attr>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('function, inside a call to');
    Say (AttrStr ('Say (', CommandAttr) +
         AttrStr ('<Text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('or');
    Say (AttrStr ('SayLn (', CommandAttr) +
         AttrStr ('<Text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('or');
    Say (AttrStr ('SayPara (', CommandAttr) +
         AttrStr ('<Text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('or even');
    SayLn (AttrStr ('SayAttr (', CommandAttr) +
         AttrStr ('<Text, Attr>', VarAttr) +
         AttrStr (')', CommandAttr) + '.');

    SayPara ('The');
    Say (AttrStr ('AttrStr (', CommandAttr) +
         AttrStr ('<Text, Attr>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('function returns a string with the appropriate attribute codes');
    Say ('already embedded in it.  This allows you to concatenate');
    Say ('two or more color-coded strings for special effects such as');
    Say (AttrStr ('S', WhiteRed + blinking) +
         AttrStr ('P', WhiteBrown + blinking) +
         AttrStr ('E', WhiteGreen + blinking) +
         AttrStr ('C', WhiteCyan + blinking) +
         AttrStr ('T', WhiteBlue + blinking) +
         AttrStr ('R', WhiteMagenta + blinking) +
         AttrStr ('A', WhiteLightGray + blinking) +
         '.');
    Say ('For example:');
    Say (AttrStr ('Say (', CommandAttr) +
         AttrStr ('<Text + AttrStr (<text, attr>) + text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('will let you put text of any color');
    Say ('you want in the middle of a line, or even in the middle');
    SayLn ('of a wo' + AttrStr ('r', ItalicAttr) + 'd.');

    SayPara ('A word of caution:  poor choices of colors,');
    Say ('or too many colors on the screen at the same');
    Say ('time, can be confusing or even annoying');
    Say ('to the user.  This program has been a deliberate demonstration');
    Say ('of the power of the');
    SayAttr ('SayOb', NameAttr);
    Say ('object, but');
    Say ('the author is the first to acknowledge that');
    Say ('excessive demonstrations do not necessarily');
    SayLn ('represent the most attractive design.');
    end;

  With HeadLine do begin
    SayPara ('Examine the source code for this demonstration to see');
    Say ('how best to use the');
    Say (AttrStr ('AttrStr (', CommandAttr) +
         AttrStr ('<Text, Attr>', VarAttr) +
         AttrStr (')', CommandAttr));
    SayLn ('method.');
    SayLn ('');
    end;

    Pause;
    ClrScr;

  With HeadLine do
    SayLn ('Conclusion:');

  With NormText do begin
    SayPara ('Thank you for taking the time to run this');
    Say ('demonstration.');
    Say ('I wrote this unit because I wanted a way to write');
    Say ('attractively formatted text to the screen that was as');
    Say ('easy as using the');
    Say (AttrStr ('WriteLn (', CommandAttr) +
         AttrStr ('<text>', VarAttr) +
         AttrStr (')', CommandAttr));
    Say ('command.  Your feedback will be appreciated.');
    Say ('The next version of this unit will include descendant objects');
    SayLn ('for writing formatted text to the printer and to diskfiles.');
    SayPara ('This unit was written under');
    Say (AttrStr ('Turbo Pascal, Version 5.5', NameAttr) + ';');
    Say ('and requires the three units from');
    SayAttr ('Turbo Professional, Version 5.0', NameAttr);
    SayLn ('for compilation.');
    end;

  With IndentedText do begin
    SetParams (10, 60, LightGreen, true);
    SayPara ('This program was written by David Gerrold,');
    Say ('CompuServe ID:  70307,544.');
    Say ('Copyright 1989, by David Gerrold and The Brass Cannon Corporation.');
    SayLn ('All rights not specifically granted in this license are reserved.');
    SayPara ('This software is');
    SayAttr ('not', Yellow);
    Say ('public domain.  It is shareware.  If you find this software');
    Say ('useful, you are requested to make a donation of $25 or more');
    Say ('to the AIDS Project, Los Angeles.  Donations may be forwarded');
    Say ('via The Brass Cannon Corp, 9420 Reseda Blvd., #804, Northridge,');
    SayLn ('CA 91328.');
    end;

    PauseWithPrompt ('Press any key to exit demo.');

    WriteLn;
    WriteLn;
    WriteLn ('This ends the demonstration.');
    WriteLn ('The normal text attribute has not been disturbed.');
END;

{ ========================================================================= }
{  Initialization :                                                         }
{ ========================================================================= }

BEGIN
  Simon.Init;
END.

{ ========================================================================= }

{
  Extract and run the program below to see how SayOb works.
}

PROGRAM SayDemo;

USES DgSay;

BEGIN
  SayDoc;
END.